perm filename SCORZ.F4[FOO,MUS] blob
sn#007298 filedate 1972-11-04 generic text, type T, neo UTF8
00100 C 6/10/71******************** SCORE ******************** LELAND SMITH, SEP.1969
00200
00300 C THIS PROGRAM WRITES NOTE LISTS FOR THE PDP10 SOUND GENERATION PROGRAM.
00400 C LOAD 'SCORE' WITH BRZ.REL (RANDOM NUMBER GENERATOR AND 'ZERPP') AND,
00500 C IF # OF INSTS IS CHANGED, ALSO CHANGE # IN 'INFO' FORMAT.
00600 C IF DESIRED, A SUBROUTINE WITH THE FOLLOWING HEADING:
00700 C SUBROUTINE SUBR
00800 C COMMON /INS/ INST(27),BG(60)
00900 C COMMON P(30),INUM,IPAR,CNT(27),BT,PL(48),IREST,DF
01000 C INUM=INST# IPAR=PARAM# BT=BASIC TIME P1 WHEN SUBROUTINE IS CALLED
01100 C IF IREST IS <0, THAT NOTE WILL BE A REST.
01200 C INST=INST. NAME, BG=INSTS' BEGIN TIMES.
01300 C NOTE #S IN SUBROUTINE: (1-84) C4=37 FS4=43 C5=49 F1=86 F15=100 (NO F16!)
01400
01500 DATA KZY/27/,ISEMI/';'/,RTF/.05/,IQT/'"'/
01600 COMMON /Q/ BNW(100),NWZ
01700 COMMON /INS/INST,BG
01800 DIMENSION ROFF(27),V(4000),NP(27),PCH(27,32),INST(27),RDEV(27)
01900 1 ,IPT(27,31),XT(27),BG(60),OTH(20,16),SCAL(101)
02000 1 ,IV(4000),NCNT(27,32),P1(27),IT(30)
02100 1 ,IOUT(70),IFM(80),COPY(30),LIST(78),JPT(837)
02200 C WITH VX,IOUT AT 70 AND IFM AT 80 OK FOR ONLY 40 LIT CHARS + 30 PARAMS PER INST.
02300 C 60 BG TIMES AVAILABLE. FOR INSTS AND INSERTS AND EDITS.
02400 COMMON P(30),J,L,CNT(27),BT,PL(48),MK,DF,DUR(27)
02500 1 ,IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
02600 1 ,INP(72),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
02700 EQUIVALENCE (PP1,P(1)),(P(2),P2),(P(3),P3),(P(4),P4),(VX1,VX(1)),
02800 1(INP1,INP(1)),(PL4,PL(4)),(IPP,ISCA(2)),(IEN,ISCA(4)),(IPT,JPT)
02900 1,(ISS,ISCA(9)),(ITT,ISCA(11)),(IE,ISCA(5)),(ID,ISCA(3))
03000 1,(IF,ISCA(6)),(IAA,ISCA(10)),(VX2,VX(2)),(VX3,VX(3)),(NCNT,PCH)
03100 1,(VX4,VX(4)),(VX5,VX(5)),(IDOT,IDAT(11)),(VX,IOUT),(IFM3,IFM(3))
02300 C 60 BG TIMES AVAILABLE. FOR INSTS AND INSERTS AND EDITS.
02400 COMMON P(30),J,L,CNT(27),BT,PL(48),MK,DF,DUR(27)
02500 1 ,IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
02600 1 ,INP(72),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
02700 EQUIVALENCE (PP1,P(1)),(P(2),P2),(P(3),P3),(P(4),P4),(VX1,VX(1)),
02800 1(INP1,INP(1)),(PL4,PL(4)),(IPP,ISCA(2)),(IEN,ISCA(4)),(IPT,JPT)
02900 1,(ISS,ISCA(9)),(ITT,ISCA(11)),(IE,ISCA(5)),(ID,ISCA(3))
03000 1,(IF,ISCA(6)),(IAA,ISCA(10)),(VX2,VX(2)),(VX3,VX(3)),(NCNT,PCH)
03100 1,(VX4,VX(4)),(VX5,VX(5)),(IDOT,IDAT(11)),(VX,IOUT),(IFM3,IFM(3))
03200 1,(IT,INP(27)),(V,IV),(PLAY,ISCA(7)),(IFM2,IFM(2)),(IFM4,IFM(4))
03300 1,(IFM(3),LIST)
03400 DATA KSLA/'/'/,IBLA/' '/,BLA/' '/,IXX/'X'/,ITMPO/'TEMPO'/
03500 1 ,ISCA/'C','P','D','N','E','F','PLAY;','G','S','A','T','B'/
03600 1 ,IDAT/'0','1','2','3','4','5','6','7','8','9','.'/
03700 1 ,SCAL/'C/8','CS/8','D/8','DS/8','E/8','F/8','FS/8','G/8',
03800 1 'GS/8','A/8','AS/8','B/8','C/4','CS/4','D/4','DS/4','E/4',
03900 1 'F/4','FS/4','G/4','GS/4','A/4','AS/4','B/4','C/2','CS/2',
04000 1 'D/2','DS/2','E/2','F/2','FS/2','G/2','GS/2','A/2',
04100 1 'AS/2','B/2','C','CS','D','DS','E','F','FS','G','GS','A',
04200 1 'AS','B','C*2','CS*2','D*2','DS*2','E*2','F*2','FS*2','G*2',
04300 1 'GS*2','A*2','AS*2','B*2','C*4','CS*4','D*4','DS*4','E*4',
04400 1 'F*4','FS*4','G*4','GS*4','A*4','AS*4','B*4','C*8','CS*8',
04500 1 'D*8','DS*8','E*8','F*8','FS*8','G*8','GS*8','A*8','AS*8',
04600 1 'B*8','R','F1','F2','F3','F4','F5','F6','F7','F8','F9',
04700 1 'F10','F11','F12','F13','F14','F15','END'/
04800 1,IFM(1)/'('/,IFM2/'1XA5,'/,IFCOM/5H', ',/,IA1/'A1,'/,I1X/'1X'/
04900 TYPE 8002
05000 LPAR=0
05100 RETRO=-1.
05200 INVRT=-1
05300 LCNT=1
05400 PARENS=0
05500 JZ=1
05600 CALL RNDINT
05700 PR=0
05800 IAMP=0
05900 C IAMP IS 'BLANK LINE'FLAG ON PP1-3.
06000 T5=0
06100 NINS=0
06200 K=0
06300 IDALL=-1
06400 QTS=-1.
06500 KB=0
06600 NWZ=1
06700 BNW(1)=0
06800 I=1
06900 KL=0
07000 TP=0
07100 KN=IBLA
07200 RA=0
07300 CHN=0
07400 DO 11281 K=1,77,3
07500 11281 LIST(K)=0
07600 C INITIALIZES MOTIVIC LIST FOR ERROR FINDING ROUTINE.
07700 NWX=0
07800 BY=-1
07900 DO 1128 K=1,KZY
07950 RDEV(K)=0
08000 INST(K)=0
08100 CNT(K)=0
08200 NP(K)=0
08300 IPT(K,1)=0
08400 DO 1128 L=1,32
08500 1128 PCH(K,L)=0
08600 C TYPE 'FILE NAME', TEMPO FACTOR(0=1), AMPL.FACT(0=1), SECONDS TO BE OMITTED, DUR AT CUTOFF.
08700 1112 ACCEPT 8001,K,TF,AMPFAC,OP1,DURX
08800 IF(AMPFAC.EQ.0)AMPFAC=1.
08900 IF(TF.EQ.0)TF=1.
09000 C******* MAY 25,71
09100 IF(K.NE.'INFO')GO TO 3128
09200 TYPE 8002
09300 TYPE 1113
09400 TYPE 118
09500 TYPE 1114
09600 TYPE 8002
09700 GO TO 1112
09800 118 FORMAT(' TO DSK=1, TTY=2, BOTH=0, LPT=22, PROOF=3, DEBUG=4'/)
09900 8002 FORMAT(' TYPE FILE NAME'/)
10000 8001 FORMAT(A5,4F)
10100 107 FORMAT(I,A5,5F)
10200 1113 FORMAT(' NAME, TF, AMPFAC, OMIT", DUR".'/)
10300 1114 FORMAT(' N1, N2=RAN NUM, N3=LIST INPUT? N4=SINGLE INST.'/
10400 1 ' N1=22 NO INPUT PRINTS, =3 DURS ONLY, =4 V ARRAY'/
10500 1 3X' 27 INSTRUMENTS ARE AVAILABLE'/)
10600 3128 IF(K.NE.IBLA)IFLNM=K
10700 CALL IFILE(1,IFLNM)
10800 READ(1,107)LN,ISLAC
10900 TYPE 118
11000 IF(DURX.EQ.0)DURX=19999.
11100 IXIN=1
11200 DO 1107 K=1,30
11300 1107 PL(K)=1.
11400 INONLY=-1
11500 ACCEPT 300,MX,X,Y,Z
11600 IF(Z.NE.0)INONLY=Z
11700 IF(X.NE.0)IXIN=X
11800 C MX=3 GIVES DURS ONLY
11900 C TO SUPPRESS LIST OF INPUT DATA, TYPE ANY 3RD NUM. (BUT 9.)
12000 C (1 1 1 =RECORD,RAN. NUM=1,SUPPRESS INPUT.)
12100 MZ=0
12200 JOUT=5
12300 C 5=OUTPUT TO TTY
12400 SOS=0
12500 IF(Y.NE.0)SOS=-1.
12600 C IF 3RD NUM≠0, EDIT FILE WILL PRINT AS IT IS READ.
12700 IF(MX.NE.22)GO TO 2107
12800 JOUT=22
12900 REWIND 22
13000 2107 IF(MX.LE.1)MX=MX-2
13100 IF(MX.EQ.-2.OR.MX.EQ.2.OR.MX.EQ.22)MZ=-1
13200 IF(MX.EQ.4)MZ=-4
13300 IF(SOS)WRITE(JOUT,107),LN,ISLAC
13400 C************ MAY 25,71
13500 C *************** READS INPUT ***********************
13600 2308 READ(1,2773,END=2337)LN,J,INP
13700 IF(J.EQ.IBLA)GO TO 2308
13800 IF(SOS)WRITE(JOUT,2773),LN,J,INP
13900 MLX=1
14000 IZ=0
14100 JA=-1
14200 ISUB=4
14300 ALL=1.
14400 VX1=0
14500 VX2=0
14600 VX3=0
14700 LK=-1
14800 K=0
14900 IF(V(I-1).NE.-9900.-BY)GO TO 6773
15000 BY=-1.
15100 I=I-1
15200 C********* FEB 15,71
15300 6773 K=K+1
15400 IF(K.GT.NINS)GO TO 36
15500 IF(INST(K).NE.J)GO TO 6773
15600 LK=K
15700 GO TO 1773
15800 36 IF(J.EQ.'RUN;'.OR.J.EQ.'RUN ;'.OR.J.EQ.'RUN')GO TO 2337
15900 IF(J.EQ.'ADD')J='INSER'
16000 IF(J.EQ.'INSER'.OR.J.EQ.'EDIT')ISUB=6
16100 IF(J.EQ.J,INP
13700 IF(J.EQ.IBLA)GO TO 2308
13800 IF(SOS)WRITE(JOUT,2773),LN,J,INP
13900 MLX=1
14000 IZ=0
14100 JA=-1
14200 ISUB=4
14300 ALL=1.
14400 VX1=0
14500 VX2=0
14600 VX3=0
14700 LK=-1
14800 K=0
14900 IF(V(I-1).NE.-9900.-BY)GO TO 6773
15000 BY=-1.
15100 I=I-1
15200 C********* FEB 15,71
15300 6773 K=K+1
15400 IF(K.GT.NINS)GO TO 36
15500 IF(INST(K).NE.J)GO TO 6773
15600 LK=K
15700 GO TO 1773
15800 36 IF(J.EQ.'RUN;'.OR.J.EQ.'RUN ;'.OR.J.EQ.'RUN')GO TO 2337
15900 IF(J.EQ.'ADD')J='INSER'
16000 IF(J.EQ.'INSER'.OR.J.EQ.'EDIT')ISUB=6
16100 IF(J.EQ.ITMPO.OR.J.EQ.'CONDU'.OR.J.EQ.'PLAY'.OR.ISUB.GT.4)
16200 1GO TO 1773
16300 IF(J.EQ.'SECTI')GO TO 1081
16400 C****************** ABOVE AND BELOW FOR 'SECTIONS'
16500 IF(J.EQ.'END'.OR.J.EQ.'END S'.OR.J.EQ.'FINIS')GO TO 1082
16600 LK=NINS+1
16700 IF(LK.GT.KZY)GO TO 99
16800 INST(LK)=J
16900 IZ=LK
17000 GO TO 1773
17100
17200 C*********** DOWN TO 99 FOR 'SECTIONS'
17300 1083 V(I)=-99.
17400 KL=1
17500 GO TO 3083
17600 C READS 'PLAY SECT. N1,N2'
17700 1081 V(I)=-199.
17800 KL=4
17900 3083 DO 2081 K=KL,72
18000 IF(INP(K).EQ.IBLA)GO TO 2081
18100 IV(I+1)=INP(K)
18200 I=I+2
18300 3081 BY=-1.
18400 GO TO 2308
18500 2081 CONTINUE
18600 C READS SECTION IDENTIFIER, -199. MARKS BEGINNING
18700 C1082 IF(V(I-1).EQ.-9900.-BY)I=I-1
18800 C********* FEB 15,71
18900 1082 V(I)=-299.
19000 I=I+1
19100 GO TO 3081
19200 C MARKS END OF SECTION
19300 C************************
19400
19500 99 TYPE 199,LN
19600 STOP
19700 199 FORMAT(' ERROR!! LAST LINE READ =',I6/)
19800 4 IF(LK.LE.NINS)GO TO 8773
19900 IF(ALL.GT.0)GO TO 1004
20000 IF(IDALL.GT.0)GO TO 8773
20100 BG(LK)=VX1
20200 IDALL=LK
20300 GO TO 2004
20400 C 'MOVE' CHANGES IN 'ALINS' CAN'T BE RESET IN INDIV. INSTS.
20500 1004 BG(LK)=VX1
20600 IF(LK.EQ.IZ)VX1=0
20700 C MAY 3,71 **** ALL PARAMS WILL BE SET UP AT TIME 0. CHECK EFFECT ON 'MOVE'!
20800 C ******** APR.23, 1971 FIXES BG TIMES IN 'MOVE'?????!!!!!!!
20900 2004 NINS=LK
21000 IF(VX3.NE.0)VX2=10000.+VX3
21100 IF(VX2.EQ.0)VX2=-1
21200 DUR(LK)=VX2
21300 GO TO 900
21400 C******** ABOVE FOR REST ONLY ENTRIES. FEB 18,71
21500 8773 IF(VX2.NE.0)VX1=VX1*10000.+VX2
21600 900 IF(VX1.EQ.BY.AND.J.NE.'PLAY')GO TO 5773
21700 C*********** 'PLAY' IS FOR 'SECTIONS'
21800 BY=VX1
21900 C BY=CURRENT BG TIME.
22000 C********* FEB 15,71
22100 V(I)=-9900.-BY
22200 I=I+1
22300 IF(NWZ.NE.0)CALL BGSORT(BY)
22400 5773 IF(J.EQ.'TEMPO')GO TO 1106
22500 IF(J.EQ.'CONDU')GO TO 3018
22600 IF(J.EQ.'PLAY')GO TO 1083
22700 C*********** ABOVE FOR 'SECTIONS'
22800 4773 NW=LPAR
22900 IF(I.GT.1900.)TYPE 107,I
23000 ALL=1.
23100 ISUB=1
23200 1299 IF(JZ.NE.0)GO TO 1773
23300 7773 READ(1,2114)LN,INP
23400 IF(INP1.EQ.IBLA)GO TO 7773
23500 IF(SOS)WRITE(JOUT,2114),LN,INP
23600 MLX=1
23700 C 'LISTS' MUST END WITH *
23800 1773 JZ=0
23900 N=0
24000 17731 ML=MLX
24100 DO 236 JDD=ML,72
24200 JD=JDD
24300 IF(N.EQ.'"')GO TO 536
24400 N=INP(JD)
24500 C ((((())))) MAY 13,71 /Z (D4/E/X 2 3/) CS/ ETC. CAN USE 26 LABELS.
24600 33611 IF(N.NE.'('.AND.N.NE.')')GO TO 2361
24700 INP(JD)=IBLA
24800 L=JD-1
24900 5113 IF(INP(L).NE.IBLA)GO TO 2113
25000 L=L-1
25100 GO TO 5113
25200 2113 IF(N.EQ.')')GO TO 3361
25300 IF(PARENS.EQ.0)GO TO 1140
25400 LCNT=LCNT+3
25500 MOT=LCNT-1
25600 1140 DO 11401 JC=1,LCNT-1,3
25700 IF(INP(L).NE.LIST(JC))GO TO 11401
25800 C FINDS DUPLICATE IDENTIFIER
25900 TYPE 11402,INP(L)
26000 GO TO 99
26100 11402 FORMAT(' MOTIVIC (',A1,') USED TWICE')
26200 11401 CONTINUE
26300 LIST(LCNT)=INP(L)
26400 PARENS=-1.
26500 INP(L)=IBLA
26600 LIST(LCNT+1)=I
26700 33612 IF(QTS)GO TO 236
26800 GO TO 6721
26900 C ''''''' FOR SINGLE QUOTES
27000 3361 L=I-1
27100 IF(QTS.AND.V(L).EQ.999.)L=L-1
27200 IF(PARENS.EQ.0)GO TO 2140
27300 LIST(LCNT+2)=L
27400 LCNT=LCNT+3
27500 PARENS=0
27600 GO TO 33612
27700 2140 LIST(MOT)=L
27800 GO TO 33612
27900 C ))))))))))) LAST ) CAN'T APPEAR AT END OF LINE!!
28000 C @@@@@@@@@@@@ /@Z/DS3/ ETC.
28100 2361 IF(N.NE.'@')GO TO 5361
28200 DO 113 L=1,72
28300 K=JD+L
28400 C K IS USED AT 240!!!
28500 JG=INP(K)
28600 IF(JG.NE.'-')GO TO 6113
28700 RETRO=0
28800 INP(K)=IBLA
28900 GO TO 113
29000 6113 IF(JG.NE.'$')GO TO 7113
29100 C '$' IS FOR INVERSIONS IN 'NOTES'
29200 INVRT=0
29300 GO TO 113
29400 7113 IF(JG.NE.IBLA)GO TO 4113
29500 113 CONTINUE
29600 4113 DO 6361 L=1,LCNT,3
29700 IF(JG.NE.LIST(L))GO TO 6361
29800 VX1=0
29900 DO 40 M=JD+2,72
30000 JG=INP(M)
30100 IF(JG.EQ.IBLA)GO TO 40
30200 IF(JG.EQ.KSLA.OR.JG.EQ.ISEMI.OR.JG.EQ.'*')GO TO 140
30300 ML=M
30400 GO TO 240
30500 40 CONTINUE
30600 240 JC=JA
30700 JA=-1
30800 INP(K)=IBLA
30900 CALL SCANR
31000 JA=JC
31100 140 JC=1
31200 KN=LIST(L+1)
31300 M=LIST(L+2)+1
31400 IF(RETRO)GO TO 640
31500 JC=M-1
31600 M=KN-1
31700 KN=JC
31800 JC=-1
31900 RETRO=-1.
32000 640 IF(INVRT)GO TO 940
32100 840 X=V(KN)
32200 V(I)=X+VX1
32300 C FINDS CENTER FOR INVERSION (+TRANSP.)
32400 I=I+1
32500 KN=KN+JC
32600 IF(V(KN-JC).NE.85.)GO TO 940
32700 V(I-1)=85.
32800 GO TO 840
32900
33000 940 Z=V(KN)
33100 IF(INVRT.EQ.0)GO TO 440
33200 IF(VX1.EQ.0)GO TO 540
33300 C " @Q N " WHERE N= 1/2 STEPS IN 'NOTES' OR MULT FACTOR I-1
30800 INP(K)=IBLA
30900 CALL SCANR
31000 JA=JC
31100 140 JC=1
31200 KN=LIST(L+1)
31300 M=LIST(L+2)+1
31400 IF(RETRO)GO TO 640
31500 JC=M-1
31600 M=KN-1
31700 KN=JC
31800 JC=-1
31900 RETRO=-1.
32000 640 IF(INVRT)GO TO 940
32100 840 X=V(KN)
32200 V(I)=X+VX1
32300 C FINDS CENTER FOR INVERSION (+TRANSP.)
32400 I=I+1
32500 KN=KN+JC
32600 IF(V(KN-JC).NE.85.)GO TO 940
32700 V(I-1)=85.
32800 GO TO 840
32900
33000 940 Z=V(KN)
33100 IF(INVRT.EQ.0)GO TO 440
33200 IF(VX1.EQ.0)GO TO 540
33300 C " @Q N " WHERE N= 1/2 STEPS IN 'NOTES' OR MULT FACTOR I-1
30800 INP(K)=IBLA
30900 CALL SCANR
31000 JA=JC
31100 140 JC=1
31200 KN=LIST(L+1)
31300 M=LIST(L+2)+1
31400 IF(RETRO)GO TO 640
31500 JC=M-1
31600 M=KN-1
31700 KN=JC
31800 JC=-1
31900 RETRO=-1.
32000 640 IF(INVRT)GO TO 940
32100 840 X=V(KN)
32200 V(I)=X+VX1
32300 C FINDS CENTER FOR INVERSION (+TRANSP.)
32400 I=I+1
32500 KN=KN+JC
32600 IF(V(KN-JC).NE.85.)GO TO 940
32700 V(I-1)=85.
32800 GO TO 840
32900
33000 940 Z=V(KN)
33100 IF(INVRT.EQ.0)GO TO 440
33200 IF(VX1.EQ.0)GO TO 540
33300 C " @Q N " WHERE N= 1/2 STEPS IN 'NOTES' OR MULT FACTOR IN OTHERS.
33400 IF(CODE.EQ.-33.)GO TO 440
33500 V(I)=Z*VX1
33600 GO TO 7361
33700 440 IF(Z.EQ.85.)GO TO 540
33800 Y=0
33900 IF(INVRT.EQ.0)Y=(X-Z)*2.
34000 V(I)=Z+VX1+Y
34100 GO TO 7361
34200 540 V(I)=Z
34300 7361 I=I+1
34400 KN=KN+JC
34500 IF(KN.NE.M)GO TO 940
34600
34700 INVRT=-1
34800 RB=V(I-1)
34900 ICT=-1
35000 DO 8361 L=JD,72
35100 JG=INP(L)
35200 INP(L)=IBLA
35300 IF(JG.EQ.KSLA)GO TO 9361
35400 IF(JG.EQ.ISEMI)GO TO 93611
35500 8361 IF(JG.EQ.'*')ICT=0
35600 9361 MLX=L
35700 C FIX THIS & =IBLA BY CHNGING DO LOOP TO 'GO TO' AT 6721,2722
35800 IF(ICT.AND.QTS)GO TO 17731
35900 JZ=-1
36000 CC GOES ANYWAY GO TO 3013
36100 93611 IF(ICT.AND.QTS)GO TO 7773
36200 C********↑↑ ↑↑ WAS TO 6017 JUNE 10,71
36300 IF(QTS)GO TO 3013
36400 IF(ICT)GO TO 6721
36500 GO TO 2722
36600 C ''''''''' FOR SINGLE QUOTES.
36700 6361 CONTINUE
36800 GO TO 99
36900 C @@@@@@@@@@@@@@@@@@@@@@@@@@
37000 5361 IF(N.NE.IAA)GO TO 4361
37100 C FINDS 'ALL'.
37200 IF(INP(JD+1).NE.'L')GO TO 236
37300 INP(JD)=IBLA
37400 INP(JD+1)=IBLA
37500 INP(JD+2)=IBLA
37600 ALL=-1.
37700 GO TO 236
37800 C TYPE 'ALL' AFTER PARAM NUM TO P39900 C CHANGES DOTTED RHYTHMS TO '1'S.
40000 736 IF(N.NE.'*')GO TO 236
40100 IAMP=-1
40200 INP(JD)=ISEMI
40300 236 CONTINUE
40400 GO TO 99
00100 101 N=INP(ML)
00200 IZ=ML
00300 ML=ML+1
00400 IF(N.EQ.IBLA)GO TO 101
00500 C ⊗⊗⊗⊗⊗ MAY 13,71 @@@@@@@@@@
00600 JA=-1
00700 IF(N.EQ.IPP)GO TO 1
00800 IF(N.EQ.IE)GO TO 2308
00900 IF(N.EQ.'R')GO TO 2337
01000 C 'RUN' MAY REPLACE 'END' FOR LAST INST.
01100 IF(N.EQ.ID)GO TO 7720
01200 GO TO 99
01300 1 CALL SCANR
01400 LPAR=VX1
01500 IAMP=0
01600 IF(LPAR.GT.NP(LK).AND.LPAR.LT.31)NP(LK)=LPAR
04000 IF(N.EQ.IEN)GO TO 6005
04100 IF(N.EQ.'M')GO TO 703
04200 IF(N.EQ.'L')GO TO 2720
04300 IF(N.EQ.ISS)GO TO 6703
04400 IF(N.EQ.ITT)GO TO 4018
04500 IF(N.EQ.IQT)GO TO 5720
04600 IF(N.EQ.ISEMI)GO TO 2018
04700 IF(N.EQ.IPP)JA=-1
04800 C FOR /P5 P3/
04900 CALL SCANR
05000 IF(ISUB.EQ.8)GO TO 8
05100 I=I+JJ
05200 V(IJ+1)=NNUM
05300 IF(JJ.EQ.1)GO TO 4006
05400 C IF NNUM IS '-2' THEN NOTES ARE PRINTED
05500 IF(NNUM.NE.-2)GO TO 5006
05600 IX=IJ+3
05700 DO 2006 K=2,JJ,3
05800 X=VX(K)
05900 Y=VX(K+1)
06000 IF(X.GT.Y)VX(K)=X+.999
06100 2006 IF(Y.GT.X)VX(K+1)=Y+.999
06200 C FOR RAN. SELEC. OF NOTES. FINDS HIGHEST NOTE.
06300 5006 IX=IJ+2
06400 DO 6006 K=1,JJ
06500 6006 V(IX+K)=VX(K)
06600 GO TO 3013
06700 4006 IF(JA)VX1=VX1/100.+9999.
06800 C CHANGES /P5 P3/ TO /P5 9999.03/
06900 V(I-1)=VX1
07000 GO TO 3013
07100 6702 IF(NL.EQ.IE)GO TO 2703
07200 IF(NL.EQ.ITT)GO TO 4018
07300 CODE=-22
07400 GO TO 1016
07500 6005 CODE=-33
07600 IF(NL.NE.'U')GO TO 1016
07700 CODE=-44.
07800 JA=-1
07900 GO TO 1016
08000 8702 CODE=-35
08100 IF(NL.EQ.'U')GO TO 1016
08200 ML=ML+1
08300 CALL SCANR
08400 7 V(IJ+1)=CODE
08500 V(IJ+2)=1.
08600 V(I)=VX1+85.
08700 GO TO 7703
08800 703 BW=V(IJ-2)
08900 IC=0
09000 DO 7031 K=ML+1,72
09100 IF(INP(K).EQ.ISEMI)GO TO 8031
09200 7031 IF(INP(K).EQ.IXX)IC=-1
09300 C**************** JUNE 1,71 X 4
09400 8031 I=I-1
09500 V(I)=0
09600 C ********* FEB. 15,71
09700 X=-9900.-BY
09800 IF(BY.EQ.0)X=-9900.-BG(LK)
09900 IF(BW.EQ.X)GO TO 8005
10000 IF(BW.NE.-9900.-BY)GO TO 1102
10100 V(IJ-2)=X
10200 GO TO 8005
10300 1102 V(IJ)=V(IJ-1)
10400 V(IJ-1)=X
10500 IJ=IJ+1
10600 I=I+1
10700 8005 LP=IJ-1
10800 BW=-9900.-X
10900 ISUB=2
11000 IZ=-1
11100 C ABOVE ARRANGES NECESSARY BG TIME HEADINGS.
11200 4703 GO TO 1299
11300 102 IF(IZ.LT.0)GO TO 2102
11400 BW=V(ICT)+BW
11500 V(I)=-9900.-BW
11600 V(I+1)=V(LP)
11700 V(I+2)=(JJ+2)*ALL
11800 V(I+3)=CODE
11900 I=I+4
12000 IZ=1
12100 2102 IF(BW.LT.10000.)CALL BGSORT(BW)
12200 C ROUND-OFF NONSENSE
12300 2 VX3=-9900.
12400 VX2=VX3
12500 CALL SCANR
12600 IF(JJ.EQ.4)GO TO 99
12700 IF(VX3.NE.-9900.)GO TO 3102
12800 IF(VX2.NE.-9900.)GO TO 4102
12900 VX2=VX1
13000 VX1=10000.
13100 4102 VX3=VX2
13200 JJ=3
13300 C 1,2 OR 3 NUMS CAN BE USED IN NON-RAN MOVES.
13400 3102 IF(IZ.GE.0)GO TO 3006
13500 V(IJ)=(JJ+2)*ALL
13600 C WORD COUNT
13700 CODE=-55.
13800 IF(JJ.NE.3)CODE=-57.
13900 C THIS IS NOW OUT, FEB 15,70. -10000. MEANS 'NOTES AT BG TIME 0'
14000 IF(NFLG)CODE=CODE-1.
14100 IF(IC)CODE=-59.
14200 C**************** JUNE 1,71
14300 C CODE=-56 OR -58 FOR NOTES.
14400 V(IJ+1)=CODE
14500 IZ=0
14600 3006 IF(NFLG.EQ.1)GO TO 5005
14700 IF(VX2.GT.VX3)VX2=VX2+.999
14800 IF(VX3.GE.VX2)VX3=VX3+.999
14900 IF(JJ.EQ.3)GO TO 5005
15000 IF(VX4.GT.VX5)VX4=VX4+.999
15100 IF(VX5.GE.VX4)VX5=VX5+.999
15200 C FOR RAN. SELEC. OF NOTES. FINDS HIGHEST NOTE.
15300 5005 ICT=I
15400 IJ=IJ+1
15500 DO 1006 K=1,JJ
15600 1006 V(IJ+K)=VX(K)
15700 I=I+JJ
15800 IJ=I+2
15900 IF(IAMP.EQ.0)GO TO 1299
16000 C*************** MAY 18,71 ***** ALWAYS RESETS TO TIME 0 WHEN MOVE IS USED.
16100 V(I)=-9900.-BY
16200 GO TO 8703
16300 1703 IF(NL.NE.IF)GO TO 4005
16400 CODE=-45.
16500 GO TO 1016
16600 C ABOVE IS FOR 'DF' (DUTY FACTOR)
16700 7703 V(IJ)=4.*ALL
16800 8703 I=I+1
16900 GO TO 4773
17000 6703 CODE=-12.
17100 IF(INP(ML+3).EQ.'L')CODE=-11.
17200 V(IJ)=2.*ALL
17300 V(IJ+1)=CODE
17400 I=I-1
17500 GO TO 4773
17600 4018 CNT(LK)=-9900.-BY
17700 P(LK)=V(I-4)
17800 READ(1,107)K,IPT(LK,1)
17900 IF(SOS)WRITE(JOUT,107),K,IPT(LK,1)
18000 C NAME OF RHYTHM FILE. (ONLY ONE PER INST.) READS DATA JUST BEFORE RUN
18100 IF(NL.NE.ITT)GO TO 2338
18200 CODE=-23.
18300 GO TO 1016
18400 2338 I=I-4
18500 GO TO 4773
18600 3018 CNT(KZY)=-9900.
18700 READ(1,107)K,IPT(KZY,1)
18800 IF(SOS)WRITE(JOUT,107),K,IPT(KZY,1)
18900 P(KZY)=980000.
19000 GO TO 2308
19100 C CAN'T USE 'TAP' OR 'RTAP' WITH INST KZY IF USING 'CONDUCT'.
19200 C 'REP'
19300 2703 ML=ML+1
19400 VX1=0
19500 VX2=0
19600 VX3=0
19700 IF(N.EQ.IXX)GO TO 2704
19800 INP(ML)=IBLA
19900 INP(ML+1)=IBLA
20000 C WIPES OUT 'EP' IN 'REP'
20100 2704 CALL SCANR
20200 V(IJ)=3.
20300 V(IJ+1)=-66.0
20400 IF(VX1.EQ.32.)VX1=1.
20500 IF(VX1.EQ.0)VX1=LPAR
20600 IF(VX2.EQ.0)VX2=LK-1
20700 V(IJ+2)=VX1+VX2*10000.
20800 KL=VX2
20900 IF(DUR(LK).LT.0)DUR(LK)=DUR(KL)
21000 IF(VX3.EQ.0)GO TO 4773
21100 L=VX3
21200 ML=LK+1
21300 DO 1018 KL=ML,L
21400 IF(LPAR.GT.NP(KL).AND.LPAR.LT.31)NP(KL)=LPAR
21500 IF(DUR(KL))DUR(KL)=DUR(LK)
21600 C TO SET DUR WHEN DUPLICATING NOTES THAT END WITH 'END;;'
21700 V(I)=V(I-4)+10000.
21800 V(I+1)=3.
21900 V(I+2)=-66.
22000 V(I+3)=V(I-1)
22100 1018 I=I+4
22200 GO TO 4773
22300
22400 2018 V(IJ)=3.
22500 V(IJ+1)=-66.
22600 V(IJ+2)=NW+LK*10000
22700 GO TO 4773
22800 C READS /P5 .3 "ABC" .7 "XYZ"/
22900
23000 8 V(IJ+1)=-77.
23100 I=I+1
23200 DO 3722 K=1,JJ,2
23300 V(I)=VX(K)
23400 3722 I=I+1
23500 V(IJ+2)=JJ/2
23600 V(IJ+3)=I
23700 DO 4722 K=2,JJ,2
23800 KN=I
23900 I=I+1
24000 L=VX(K)
24100 DO 6722 KL=L,72
24200 IF(INP(KL).EQ.IQT)GO TO 4722
24300 IV(I)=INP(KL)
24400 6722 I=I+1
24500 4722 V(KN)=I-KN-1
24600 V(IJ)=(I-IJ)*ALL
24700 GO TO 4773
24800 3721 READ(1,2114)LN,INP
24900 IF(SOS)WRITE(JOUT,2114),LN,INP
25000 ML=1
25100 GO TO 2721
25200 2720 IF(ML.GE.MLX)GO TO 3721
25300 ML=MLX
25400 2721 QTS=0
25500 ICT=-1
25600 C (@(@(@(@(@(@(@(@(@(@(@(
25700 DO 6721 K=ML,72
25800 N=INP(K)
25900 IF(N.EQ.KSLA.OR.N.EQ.'*'.OR.N.EQ.ISEMI)GO TO 7722
26000 C SLASH,ETC. WILL REPEAT 'LIT' ITEM.
26100 IF(N.NE.IQT)GO TO 67211
26200 JC=K+1
26300 GO TO 7721
26400 67211 JD=K
26500 IF(N.EQ.'('.OR.N.EQ.')'.OR.N.EQ.'@')GO TO 33611
26600 C (@(@(@(@(@( GOES TO FIRST SCANNER.
26700 IF((N.NE.IE.OR.INP(K+1).NE.IEN).AND.(N.NE.IF.OR.
26800 1 INP(K+1).NE.'I'))GO TO 6721
26900 V(I)=10000.
27000 IF(DUR(LK))DUR(LK)=1000.
27100 GO TO 27221
27200 C 'END' OR 'FINE' MAY BE USED TO TERMINATE INST.
27300 6721 CONTINUE
27400 5720 ISUB=-1
27500 JC=ML+1
27600 C FOR SINGLE 'LIT' ITEMS.
27700 7721 DO 1722 KL=JC+1,72
27800 IF(INP(KL).NE.IQT)GO TO 1722
27900 JD=KL-1
28000 ML=KL+1
28100 NL=KL-JC
28200 GO TO 8721
28300 1722 CONTINUE
28400 GO TO 99
28500 7722 ML=K
28600 C CAN'T USE SLASH FOR REPEAT AFTER @Q
28700 8721 V(I)=NL
28800 QTS=-1.
28900 C (@(@(@(@(@(@(@(@(@
29000 DO 9721 K=JC,JD
29100 I=I+1
29200 9721 IV(I)=INP(K)
29300 I=I+1
29400 IF(ISUB)GO TO 2722
29500 722 DO 4720 K=ML,72
29600 N=INP(K)
29700 IF(N.NE.KSLA)GO TO 1721
29800 ML=K+1
29900 GO TO 2721
30000 1721 IF(N.EQ.ISEMI)GO TO 3721
30100 IF(N.NE.1H*)GO TO 4720
30200 2722 V(I)=999.
30300 27221 V(IJ+1)=-88.
30400 V(IJ)=(I-IJ+1)*ALL
30500 IJ=IJ+2
30600 V(IJ)=IJ+1
30700 I=I+1
30800 IF(ISUB)GO TO 4773
30900 IF(ICT.EQ.0)GO TO 57211
31000 DO 1720 L=K+1,72
31100 IF(INP(L).NE.ISEMI)GO TO 5721
31200 JZ=0
31300 GO TO 4773
31400 5721 IF(INP(L).NE.KSLA)GO TO 1720
31500 MLX=L+1
31600 57211 JZ=-1
31700 C******** FEB 20,71 ↑&↓
31800 GO TO 4773
31900 1720 CONTINUE
32000 4720 CONTINUE
32100 GO TO 99
32200
32300 7720 V(I)=LK
32400 V(I+1)=3.
32500 V(I+2)=-67.
32600 ML=ML+4
32700 CALL SCANR
32800 V(I+3)=VX1
32900 I=I+4
33000 L=VX1
33100 IF(NP(LK).LT.NP(L))NP(LK)=NP(L)
33200 IF(DUR(LK).LT.0)DUR(LK)=DUR(L)
33300 GO TO 4773
33400 C TYPE 'DUPL N;' N=INST # TO BE DUPLICATED.
33500 142 FORMAT(I,15A5)
33600 2773 FORMAT(I,A5,72A1)
33700 2114 FORMAT(I,72A1)
33800 300 FORMAT(I,3F,A1)
33900 6 KB=KB+1
34000 IF(J.EQ.'INSER')GO TO 1340
34100 OTH(KB,1)=VX1*100000.+VX2*100.+VX3
34200 GO TO 340
34300 1340 X=VX1
34400 IF(VX2.NE.0)X=1000000.+VX1*100000.+VX2
34500 OTH(KB,1)=X
34600 GO TO 1338
34700 C ABOVE IS TO PUT INSERT AFTER NOTE # OF A PARTICULAR INSTRUMENT.
34800 C FOR COMMENT AT START, SET BG TIME TO 1,1 - BEGIN LINE WITH <,END WITH ;
34900 C UP TO 75 CHARACTERS MAY BE TYPED.
35000 340 IF(VX3.NE.2)GO TO 1338
35100 READ(1,300)K,OTH(KB,2)
35200 IF(SOS)WRITE(JOUT,300),K,OTH(KB,2)
35300 OTH(KB,3)=1.
35400 GO TO 2308
35500 1338 READ(1,142)K,(OTH(KB,JD),JD=2,16)
35600 IF(SOS)WRITE(JOUT,142),K,(OTH(KB,JD),JD=2,16)
35700 X=OTH(KB,2)
35800 IF(J.EQ.'INSER'.AND.VX3.NE.0.AND.X.NE.'*')GO TO 6
35900 IF(X.EQ.'*')KB=KB-1
36000 C ALLOWS SEVERAL LINES OF 'INSERT' IF ANY 3RD #. LAST LINE HAS '*' IN COLUMN 1.
36100 GO TO 2308
36200 C IF NO PARAM NUM IS GIVEN, ALL PARAMS MUST BE TYPED. INSERT MAY INCLUDE 10 CHARS(P3-P30),
36300 C P2, A # ONLY. IF MORE THAN 1 PARAM IS TO BE EDITED AND P2 IS35100 READ(1,300)K,OTH(KB,2)
35200 IF(SOS)WRITE(JOUT,300),K,OTH(KB,2)
35300 OTH(KB,3)=1.
35400 GO TO 2308
35500 1338 READ(1,142)K,(OTH(KB,JD),JD=2,16)
35600 IF(SOS)WRITE(JOUT,142),K,(OTH(KB,JD),JD=2,16)
35700 X=OTH(KB,2)
35800 IF(J.EQ.'INSER'.AND.VX3.NE.0.AND.X.NE.'*')GO TO 6
35900 IF(X.EQ.'*')KB=KB-1
36000 C ALLOWS SEVERAL LINES OF 'INSERT' IF ANY 3RD #. LAST LINE HAS '*' IN COLUMN 1.
36100 GO TO 2308
36200 C IF NO PARAM NUM IS GIVEN, ALL PARAMS MUST BE TYPED. INSERT MAY INCLUDE 10 CHARS(P3-P30),
36300 C P2, A # ONLY. IF MORE THAN 1 PARAM IS TO BE EDITED AND P2 IS ONE OF THEM, FIRST
36400 C EDIT P2 TO DESIRED VALUE, CHANGE P2 TO MINUS = THEN INSERT ENTIRE
36500 C NOTE TO PLAY JUST AFTER ORIGINAL NOTE(WHICH WILL BE A REST).
36600 C BX=INST N. Y=NOTE N. Z=PARAM N.
36700 1899 CALL SCANR
36800 GO TO(1,2,3,4,5,6),ISUB
00100 1106 KTMP=1
00200 TP=60.
00300 IAMP=0
00400 BW=BY
00500 ITMP=-1
00600 ISUB=5
00700 JA=-1
00800 GO TO 2016
00900 3019 V(I)=990000.00
01000 V(I+1)=4.
01100 V(I+2)=VX1
01200 V(I+3)=VX2/TP
01300 V(I+4)=VX3/TP
01400 I=I+5
01500 BY=BW
01600 C SEPT 18, 70
01700 IF(VX1.EQ.0)GO TO 2308
01800 BW=BW+VX1
01900 V(I)=-9900.-BW
02000 I=I+1
02100 CALL BGSORT(BW)
02200 9003 IF(IAMP)GO TO 4003
02300 2016 VX3=0
02400 VX2=0
02500 GO TO 1299
02600 5 IF(VX2.NE.0)GO TO 105
02700 C 'TEMPO/120*;' OR 'TEMPO/1.5 72*;' IS OK.
02800 VX2=VX1
02900 VX1=0
03000 105 IF(VX3.EQ.0)VX3=VX2
03100 IF(VX2.LT.11.)TP=1.
03200 IF(J.EQ.ITMPO)GO TO 3019
03300 PCH(1,KTMP)=VX1
03400 PCH(2,KTMP)=VX2
03500 PCH(3,KTMP)=VX3
03600 C PCH(1)=TIME (2)=MM1 (3)=MM2
03700 KTMP=KTMP+1
03800 IF(IAMP.EQ.0)GO TO 2016
03900 4003 VX1=0
04000 IAMP=0
04100 VX2=VX3
04200 IF(J.EQ.ITMPO)GO TO 3019
04300 PCH(1,KTMP)=0
04400 PCH(2,KTMP)=VX2
04500 PCH(3,KTMP)=VX2
04600 C MM CAN BE FROM 11 UP ITMPO FACTOR FROM 10 DOWN.
04700 C UP TO 30 ITMPO CHANGES MAY BE MADE.
04800
04900 1016 IA=I
05000 IZ=1
05100 3100 V(I-2)=CODE
05200 ISUB=3
05300 5016 IF(IAMP.GE.0)GO TO 1299
05400 117 IF(IZ-2)3013,9004,9004
05500 103 K=INP(ML)
05600 IF(K.EQ.ITT)GO TO 1106
05700 IF(K.EQ.ISEMI)GO TO 1014
05800 IF(K.NE.IBLA) GO TO 1899
05900 ML=ML+1
06000 GO TO 103
06100 C@@@@@@@@ MAY 13,71 @@@@@@
06200 C********
04200 IF(J.EQ.ITMPO)GO TO 3019
04300 PCH(1,KTMP)=0
04400 PCH(2,KTMP)=VX2
04500 PCH(3,KTMP)=VX2
04600 C MM CAN BE FROM 11 UP ITMPO FACTOR FROM 10 DOWN.
04700 C UP TO 30 ITMPO CHANGES MAY BE MADE.
04800
04900 1016 IA=I
05000 IZ=1
05100 3100 V(I-2)=CODE
05200 ISUB=3
05300 5016 IF(IAMP.GE.0)GO TO 1299
05400 117 IF(IZ-2)3013,9004,9004
05500 103 K=INP(ML)
05600 IF(K.EQ.ITT)GO TO 1106
05700 IF(K.EQ.ISEMI)GO TO 1014
05800 IF(K.NE.IBLA) GO TO 1899
05900 ML=ML+1
06000 GO TO 103
06100 C@@@@@@@@ MAY 13,71 @@@@@@
06200 C**********FEB 19,71
06300 C ABOVE
06400 3 IF(VX1.EQ.-99.)GO TO 4022
06500 IF(CODE.EQ.-22.)GO TO 2017
06600 C************ MAY 19,71
06700 IF(CODE.LT.-23.OR.IZ/2*2.EQ.IZ)GO TO 17
06800 C CHECKS PAIRS OF NUMBERS FOR 'RTAP'
06900 2017 IF(VX1.EQ.10000.)GO TO 17
07000 VX1=4./VX1
07100 IF(JJ.NE.1)GO TO 2014
07200 V(I)=VX1
07300 GO TO 114
07400 CC2017 V(I)=VX1
07500 2014 DO 9006 L=2,JJ
07600 IF(VX(L).EQ.0)GO TO 17
07700 9006 VX1=4./VX(L)+VX1
07800 JJ=1
07900 17 V(I)=VX1
08000 IF(JJ.EQ.1)GO TO 114
08100 L=VX(JJ)-1
08200 X=V(I)
08300 NL=I+1
08400 I=L+I
08500 DO 1017 K=NL,I
08600 1017 V(K)=X
08700 C ADDS UP TOTAL OF NOTES IN SEQ.
08800 IZ=IZ+L
08900 GO TO 114
09000 1014 V(I)=RB
09100 114 RB=V(I)
09200 I=I+1
09300 IZ=IZ+1
09400 GO TO 5016
09500 4022 JC=VX2+.3
09600 JD=VX3-.5
09700 IF(JJ.EQ.2)JD=1
09800 C********* MAY 19,71 ----MANY LINES ABOVE.
09900 IZ=IZ+JC*JD
10000 C JC=HOW MANY TIMES, JD=HOW MANY NOTES
10100 DO 1005 K=1,JD
10200 NL=I+JC-1
10300 DO 2005 L=I,NL
10400 2005 V(L)=V(L-JC)
10500 1005 I=I+JC
10600 RB=V(NL)
10700 C RB SAVES DATA FOR SLASH REPEAT FEATURE.
10800 GO TO 5016
10900
11000 9004 IF(ITMP.EQ.0)GO TO 3013
11100 C*********** JUNE 1,71
11200 KA=1
11300 IC=1
11400 K=0
11500 J=1
11600 Z=0
11700 RC=0
11800 9007 Y=PCH(3,IC)/TP
11900 X=PCH(2,IC)/TP
12000 Z=PCH(1,IC)
12100 YY=2.*Z/(Y+X)
12200 224 IF(YY.NE.0)YY=2.*(Z-X*YY)/YY**2
12300 XT(1)=X
12400 XA=RA
12500 RD=1
12600 RB=0
12700 ZZ=Z
12800 7020 RA=V(IA+K)
12900 IF(RA.EQ.10000.)GO TO 3013
13000 4020 RD=1
13100 IF(RA.LT.0)RD=-1.
13200 RA=RA*RD
13300 IF(KA.EQ.0)RA=RA-RC
13400 W=RA
13500 RB=W
13600 IF(W.LE.Z)GO TO 2020
13700 IF(Z.NE.0)GO TO 3020
13800 RA=RA/Y
13900 RB=-1.
14000 RC=0
14100 GO TO 8020
14200 3020 W=Z
14300 RC=W+RC
14400 GO TO 24
14500 2020 RC=0
14600 24 IF(X.NE.Y)GO TO 424
14700 RA=W/X
14800 GO TO 8020
14900 C DUR OF TMP + BG TIME OF TMP - NOTE VALUE - BG TIME OF NOTE. CHN=TBG.
15000 424 RAX=XT(J)
15100 RA=(-2.*RAX+(4.*RAX**2+8.*YY*W)**.5)/(2.*YY)
15200 XT(J)=RAX+YY*RA
15300 8020 IF(KA.EQ.0)RA=RA+XA
15400 KA=1
15500 IF(RC.NE.0)GO TO 1011
15600 IF(T5.EQ.1)GO TO 8203
15700 V(IA+K)=RA*RD
15800 IF(K.EQ.IZ)GO TO 3013
15900 C*********** JUNE 1,71
16000 1011 IF(T5.EQ.1)GO TO 2011
16100 K=K+1
16200 IF(ZZ.NE.0)Z=Z-W
16300 IF((Z.GT.0).OR.(RB.EQ.-1.))GO TO 7020
16400 IC=IC+1
16500 IF(RB.EQ.W)GO TO 9007
16600 KA=0
16700 K=K-1
16800 GO TO 9007
16900 C********* MAY 13,71 OMITS REPEATED RHY. FEATURE.
17000 C ML=I-1
17100 C ML=I-1
17200 C*********** MAY 13,71 ********
17300 3013 X=I-IJ
17400 V(IJ+2)=X-3.
17500 V(IJ)=X*ALL
17600 IF(CODE.NE.-35)GO TO 4773
17700 M=IJ+3
17800 C SETS NUMBERS FOR FUNCS.
17900 DO 313 K=M,I-1
18000 313 IF(V(K).LT.85.)V(K)=V(K)+85.
18100 GO TO 4773
18200
18300 2011 XA=RA
18400 IF(K.GT.1)GO TO 9020
18500 K=I-6
18600 ZPAR=-9900.-CHN-ZZ
18700 DO 3011 KL=8,I
18800 IF((V(K).EQ.ZPAR).AND.(V(K+1).EQ.990000.))GO TO 9020
18900 3011 K=K-1
19000 9020 W=ZZ
19100 IF(V(K+3ITS REPEATED RHY. FEATURE.
17000 C ML=I-1
17100 C ML=I-1
17200 C*********** MAY 13,71 ********
17300 3013 X=I-IJ
17400 V(IJ+2)=X-3.
17500 V(IJ)=X*ALL
17600 IF(CODE.NE.-35)GO TO 4773
17700 M=IJ+3
17800 C SETS NUMBERS FOR FUNCS.
17900 DO 313 K=M,I-1
18000 313 IF(V(K).LT.85.)V(K)=V(K)+85.
18100 GO TO 4773
18200
18300 2011 XA=RA
18400 IF(K.GT.1)GO TO 9020
18500 K=I-6
18600 ZPAR=-9900.-CHN-ZZ
18700 DO 3011 KL=8,I
18800 IF((V(K).EQ.ZPAR).AND.(V(K+1).EQ.990000.))GO TO 9020
18900 3011 K=K-1
19000 9020 W=ZZ
19100 IF(V(K+3))K=K+3
19200 C ABOVE IS FOR TYPED IN TEMPO CHANGES
19300 KA=K+3
19400 ZZ=V(KA)
19500 C DUR OF NEXT TEMPI
19600 X=V(KA+1)
19700 Y=V(KA+2)
19800 213 KA=0
19900 Z=ZZ
20000 YY=2.*Z/(X+Y)
20100 YY=2.*(Z-X*YY)/YY**2
20200 CHN=CHN+W
20300 XT(J)=X
20400 IF(KA.EQ.1)Z=0
20500 RA=PR
20600 KA=0
20700 K=K+3
20800 GO TO 4020
00100 2337 T=0
00200 IF(SOS)WRITE(JOUT,902)
00300 NWZZ=0
00400 IAMP=0
00500 IT3=0
00600 K=1
00700 IX=0
00800 BG(NINS+1)=19999.
00900 4011 IF(CNT(K))GO TO 5011
01000 6011 IF(K.EQ.KZY)GO TO 4337
01100 K=K+1
01200 GO TO 4011
01300 5011 L=V(I-1)/(-9900.)
01400 IF(L.EQ.1)I=I-1
01500 V(I)=CNT(K)
01600 V(I+1)=P(K)
01700 V(I+3)=-44.
01800 I=I+5
01900 IF(P(K).EQ.980000.)I=I-4
02000 KL=I
02100 CALL ZERPP
02200 ICT=IPT(K,1)
02300 CALL IFILE(1,ICT)
02400 9011 L=I+6
02500 READ(1,7011)(V(M),M=I,L)
02600 IF(V(L).EQ.999.)GO TO 8011
02700 I=L+1
02800 GO TO 9011
02900 8011 IF(P(K).NE.980000.)GO TO 6337
03000 DO 7337 K=L,I,-1
03100 7337 IF(V(K).NE.999.)GO TO 8337
03200 8337 I=K-1
03300 V(I)=0
03400 V(I+1)=V(K)
03500 V(I+2)=V(K)
03600 C K WAS I-1 ABOVE.
03700 I=I+3
03800 V(KL+1)=I-KL-1
03900 C ABOVE RESETS WORDCOUNT FOR 'CONDUCT' DATA.
04000 GO TO 4337
04100 6337 DO 5337 M=I,L
04200 KN=M
04300 5337 IF(V(M).EQ.999.)GO TO 3337
04400 3337 I=KN
04500 KN=I-KL
04600 V(KL-1)=KN
04700 V(KL-3)=KN+3
04800 GO TO 6011
04900 7011 FORMAT(7F)
05000 4337 IF(V(I-1).EQ.-9900.-BY)I=I-1
05100 V(I)=-19899.
05200 PP1=0
05300 T6=10000.
05400 DO 2118 K=1,NINS
05500 ROFF(K)=0
05600 C********* FEB 17,71
05700 M=NP(K)
05800 IT(K)=0
05900 IPT(K,31)=0
06000 NCNT(K,31)=1
06100 DO 2118 L=1,M
06200 NCNT(K,L)=1
06300 2118 IPT(K,L)=0
06400 DO 5013 K=1,IXIN
06500 5013 X=RAND(0.0,0.0)
06600 CALL ZERPP
06700 IF(MX)CALL OFILE(1,ISLAC)
06800 NW=1
06900 NWX=0
07000 TDUR=0
07100 A=0
07200 T2=1.
07300 T4=1.
07400 T5=0
07500 J=1
07600 MK=0
07700 C IS THE ABOVE NEEDED?
07800 IF(MX.NE.3)GO TO 40021
07900 K=4
08000 10023 N=V(K)/-11.
08100 IF((N.NE.2.AND.N.NE.3.AND.N.NE.4).OR.V(K-2).LT.10000.)GO TO 10021
08200 J=V(K+1)
08300 IF(J.EQ.1)GO TO 10024
08400 IF(N.EQ.3.AND.V(K+2 FORMAT(1XA5,' P',I2,' HAS ',I3,' ITEMS.')
11000 4002 FORMAT(10F12.3)
11100 1002 IF(IDALL)GO TO 600
11200 X=DUR(IDALL)
11300 DO 2002 K=1,NINS
11400 2002 IF(DUR(K))DUR(K)=X
00100 C ***** SORTER *************************
00200 C ******* OUTPUT LOOP FROM HERE ON ********
00300 600 IL=0
00400 C********** BELOW IS FOR 'SECTIONS'
00500 KODE=0
00600 NWX=NWX+1
00700 MK=MK+1
00800 Y=BNW(NW)
00900 723 IL=IL+1
01000 3723 Z=V(IL)
01100 IF(Z.EQ.-19899.)GO TO 732
01200 IF(Z.NE.-9900.-Y)GO TO 723
01300 C********** BELOW IS FOR 'SECTIONS'
01400 IF(V(IL-2).EQ.-199.)KODE=IV(IL-1)
01500 2723 IL=IL+1
01600 729 K=IL+2
01700 MOT=V(IL+1)
01800 RD=V(K)
01900 IF(RD.EQ.-67.)GO TO 3726
02000 RB=V(IL)
02100 C************ DOWN TO 4150 IS FOR 'SECTIONS'
02200 IF(RB.NE.-99.)GO TO 4150
02300 KODE=IV(K-1)
02400 2160 IF(KODE.EQ.0)GO TO 723
02500 IF(MZ)WRITE(JOUT,9150),KODE
02600 KL=Y/10000.
02700 RB=Y+KL*10000.
02800 DO 5150 KL=1,I
02900 IF(V(KL).NE.-199..OR.IV(KL+1).NE.KODE)GO TO 5150
03000 IV(K-1)=0
03100 C WHEN 'PLAY' HAS BEEN FOUND, INDENTIFIER CHNGED TO 0
03200 RD=V(KL+2)+9900.
03300 DO 6150 L=KL+2,I
03400 M=V(L)/(-9900.)
03500 IF(M.NE.1)GO TO 6150
03600 RA=RB+RD-V(L)-9900.
03700 V(L)=-9900.-RA
03800 C UPDATES BG TIMES INSIDE SECTION.
03900 CALL BGSORT(RA)
04000 C7150 IF(RA.EQ.BNW(KA))GO TO 6150
04100 C UPDATES LIST OF CHANGE TIMES.
04200 6150 IF(V(L).EQ.-299.)GO TO 160
04300 5150 CONTINUE
04400 160 IL=1
04500 GO TO 3723
04600 C*********** ABOVE IS FOR 'SECTION' REPEATS
04700 4150 LK=RB/10000.+.2
04800 IF(LK.GE.98)GO TO 7700
04900 LP=RB-LK*10000
05000 C LK=INST # LP=PARAM #
05100 LN=IPT(LK,LP)
05200 IPT(LK,LP)=IL+2
05300 IF(RD.EQ.-66.)GO TO 726
05400 IF(RD.EQ.-55..OR.RD.EQ.-56.)GO TO 1726
05500 IF(RD.EQ.-23)GO TO 6700
05600
05700 2727 ML=IPT(LK,LP)
05800 IF(MOT.GT.0)GO TO 3727
05900 C USE NEG WDCNT FOR 'ALL'
06000 DO 4727 KL=LK+1,NINS
06100 IF(NP(KL).LT.LP.AND.LP.LT.31)NP(KL)=LP
06200 IPT(KL,LP)=-(LK+(LP-1)*KZY)
06300 NCNT(KL,LP)=10000
06400 4727 IF(DUR(KL))DUR(KL)=1000.
06500 C ASSUMES THAT DURATIONS ARE SET IN 'NOTES'.
06600 C AFTER 'ALL' IS USED ONCE IT WORKS LIKE DUPL OR REP.
06700 GO TO 2150
06800 C 'MOVE' WITH 'ALINS' CAN ALTER 'RESETS'.
1)*KZY)
08900 GO TO 2727
09000 3726 LK=V(IL)
09100 M=V(K+1)
09200 KL=NP(M)
09300 DO 4726 L=1,KL
09400 IPT(LK,L)=IPT(M,L)
09500 IF(IPT(M,L).NE.0)NCNT(LK,L)=10000
09600 C****** JUN 29 71 (LK,L) WAS (L,K)....???????
09700 4726 CONTINUE
09800 IPT(LK,31)=IPT(M,31)
09900 K=0
10000 GO TO 2150
10100 C ABOVE IS FOR DUPLICATION ROUTINE NEXT ADJUSTS TIMES FOR 'RTAP'
10200 6700 KL=IL+V(IL+1)+1.3
10300 RC=V(K-2)
10400 1770 IF(V(KL))GO TO 700
10500 2700 KL=KL+V(KL+1)+1.3
10600 GO TO 1770
10700 700 KL=KL+1
10800 IF(Z.NE.V(KL-1).OR.V(KL).NE.RC)GO TO 2700
10900 KL=.98)IT3=IL+2
13600 T4=1.
13700 GO TO 2150
13800 C*************** ANY WDCNTS DOWN FROM HERE. *********
13900 C NEXT ADJUSTS 'MOVE' TIMES IF BG IS AT A NOTE NUMBER.
14000 1726 IF(V(IL-1).GT.-19000.)GO TO 2727
14100 RA=BT
14200 K=IL-1
14300 2726 V(K)=-9900.-RA
14400 ISUB=-1
14500 L=K+5
14600 RB=V(L)+V(L-1)
14700 V(L-1)=RA
14800 K=K+V(K+2)+2
14900 IF(V(K).GT.-19000..OR.V(K+1).NE.V(IL).OR.
15000 1 V(K).NE.-9900.-RB)GO TO 2727
15100 RA=RA+V(L)
15200 CALL BGSORT(RA)
15300 GO TO 2726
15400 C CONVERTS BG TIME OF NOTE NUM TO REAL TIME. DOESN'T WORK WITH -66!!
15500 C NOW WE BEGIN ON!! NOTE NUM. NOT AFTER NOTE NUM.
15600 732 DO 2606 K=NW,NWZ
15700 2606 BNW(K)=BNW(K+1)
15800 NWZ=NWZ-1
15900 IF(NWZ.EQ.0)GO TO 2111
16000 IF(NWZZ.EQ.1)GO TO 5111
16100 NWZZ=1
16200 IF(NWZ.EQ.1)GO TO 1111
16300 DO 3111 K=1,NWZ
16400 IF(BNW(K).LT.1000.)GO TO 3111
16500 X=BNW(NWZZ)
16600 BNW(NWZZ)=BNW(K)
16700 BNW(K)=X
16800 NWZZ=NWZZ+1
16900 3111 CONTINUE
17000 5111 IF(NWZZ.EQ.NWZ)GO TO 1111
17100 L=NWZZ+1
17200 X=BNW(NWZZ)
17300 DO 4111 K=L,NWZ
17400 IF(BNW(K).GT.X)GO TO 4111
17500 RA=BNW(K)
17600 BNW(K)=X
17700 X=RA
17800 4111 CONTINUE
17900 BNW(NWZZ)=X
18000 GO TO 1111
18100 111 FORMAT(1XA5,'.DAT',12X,'EDIT FILE NAME=',A5,8X,
18200 1'V ARRAY=',I4,'/2000 TEMPO FACTOR=',F6.2,4X,
18300 1'RANDOM NUMBER =',I6/)
18400 1023 FORMAT(/' < ',A5,'.DAT '/1XA5)
18500 C********** BELOW IS FOR 'SECTIONS'
18600 9150 FORMAT(/3X'******* SECTION ',A1)
18700 2111 NWZ=-1
18800 C ABOVE ORDERS BNW DATA TO SAVE TIME AT 1108 ON PG5.
18900 1111 IF(MZ.EQ.0)GO TO 1601
19000 IF(NWX.NE.1)GO TO 1486
19100 WRITE(JOUT,111),ISLAC,IFLNM,I,TF,IXIN
19200 C*********** JUNE 1,71
19300 C********** BELOW IS FOR 'SECTIONS'
19400 1486 IF(KODE.NE.0)WRITE(JOUT,9150),KODE
19500 K=NWX-1
19600 C*********** JUNE 1,71
19700 IF(NWX.GT.1.AND.IT(J).NE.-3)WRITE(JOUT,3154),K,Y
19800 IF(IT(J).EQ.-3)WRITE(JOUT,5154),K,BX,INST(J)
19900 C*********** JUNE 1,71 X 3 K'S
20000
20100 DO 602 K=1,NINS
20200 48 LK=INST(K)
20300 C*********** JUNE 1,71
20400 IF(NCNT(K,31).NE.10000.AND.NWX.GT.1)GO TO 8826
20500 NCNT(K,31)=1
20600 IJ=IPT(K,31)
20700 X=0
20800 IF(IJ.NE.0)X=V(IJ+2)
20900 WRITE(JOUT,5396),LK,X
21000 X=DUR(K)
21100 IF(X.GT.10000.)GO TO 83
21200 WRITE(JOUT,8396),X
21300 GO TO 8826
21400 5396 FORMAT(5XA5,' RANDOM TF =',F4.2,10X,'DURATION =',$)
21500 7396 FORMAT('+',F5.0,' NOTES')
21600 4396 FORMAT(5XA5,' % RANDOM RESTS DUR=',F7.3,'", FROM',
21700 1F6.3,' TO',F6.3)
21800 485 FORMAT(5XA5,' % RANDOM RESTS = ',F4.2)
21900 8396 FORMAT('+',F6.2,'"')
22000 83 X=X-10000.
22100 WRITE(JOUT,7396),X
22200 8826 IF(NCNT(K,1).NE.10000)GO TO 602
22300 NCNT(K,1)=1
22400 IJ=IPT(K,1)+2
22500 C********* FEB 19,71
22600 IF(V(IJ)-5.)GO TO 7826
22700 WRITE(JOUT,4396),LK,V(IJ-1),V(IJ),V(IJ+1)
22800 C********* FEB 19,71
22900 GO TO 602
23000 7826 WRITE(JOUT,485),LK,V(IJ)
23100 602 CONTINUE
23200 715 IF(IT3.NE.1.)GO TO 1602
23300 RA=T1*TP
23400 RB=T2*TP
23500 WRITE(JOUT,6154),RA,RB,TDUR
23600 IT3=0
23700 1602 IF(NWX.EQ.1)GO TO 315
23800 IF(IT(J).EQ.-3)GO TO 1108
23900 C*********** JUNE 1,71
24000 6154 FORMAT(' TMP=',F7.3,' TO',F8.3,' DURING',F6.2,' SECS.'/)
24100 7154 FORMAT(' ''CONDUCT'' FILE NAME = ',A5/)
24200 5154 FORMAT(/' << CHANGE',I3,' BEGINS ON NOTE',F5.0,1XA5,' >>'/)
24300 902 FORMAT(1XA5/)
24400 3154 FORMAT(/' << BASIC TIME OF CHANGE',I3,' IS',F8.3,'" >>'/)
24500 4154 FORMAT(' THE FIRST',F9.4,'" ARE OMITTED'/)
24600 C*********** JUNE 1,71
24700 IT(J)=IT(J)/10
24800 GO TO 1108
24900 315 IF(IT3.GT.1)WRITE(JOUT,7154),ICT
25000 IF(OP1.NE.0)WRITE(JOUT,4154),OP1
25100 1601 IF(NWX.GT.1) GO TO 1108
25200 IF(MZ)WRITE(JOUT,1023),ISLAC,PLAY
25300 IF(TF.GT.10.)TF=TF/60.
25400 TF=1000./TF
25500 DO 6015 K=1,30
25600 6015 COPY(K)=-9900.
25700 C INITS PARAM REPRESSION FEATURE.
25800 IF(KB.EQ.0)GO TO 9926
25900 ML=NINS+1
26000 NL=24400 3154 FORMAT(/' << BASIC TIME OF CHANGE',I3,' IS',F8.3,'" >>'/)
24500 4154 FORMAT(' THE FIRST',F9.4,'" ARE OMITTED'/)
24600 C*********** JUNE 1,71
24700 IT(J)=IT(J)/10
24800 GO TO 1108
24900 315 IF(IT3.GT.1)WRITE(JOUT,7154),ICT
25000 IF(OP1.NE.0)WRITE(JOUT,4154),OP1
25100 1601 IF(NWX.GT.1) GO TO 1108
25200 IF(MZ)WRITE(JOUT,1023),ISLAC,PLAY
25300 IF(TF.GT.10.)TF=TF/60.
25400 TF=1000./TF
25500 DO 6015 K=1,30
25600 6015 COPY(K)=-9900.
25700 C INITS PARAM REPRESSION FEATURE.
25800 IF(KB.EQ.0)GO TO 9926
25900 ML=NINS+1
26000 NL=NINS+KB
26100 DO 9826 K=ML,NL
26200 9826 BG(K)=OTH(K-NINS,1)
26300 C 'OTH' INSERTS, WITH BG TIME IN SECONDS, CAN ONLY BE SET WITH TF=1
26400 9926 DO 5015 K=1,NINS
26500 IQ(K)=BG(K)*10000.
26600 BG(K)=0
26700 INP(K)=0
26800 P1(K)=0
26900 IF(DUR(K).LT.10000.)DUR(K)=DUR(K)-.0001
27000 C******* FEB. 16,71 FOR ROUND-OFF NONSENSE
27100 5015 CNT(K)=0
27200 IF(MX)WRITE(1,1023)ISLAC,PLAY
27300 BW=0
27400 GO TO 500
00100 752 FORMAT(1X15A5)
00200 1108 M=0
00300 JC=0
00400 IF(NWZ)GO TO 1740
00500 C NWZZ IS SET AT 3111 IN SORTR.
00600 DO 740 K=1,NWZZ
00700 X=BNW(K)
00800 IF(X.GT.BT.OR.X.LE.BW.OR.BW)GO TO 2740
00900 IT(J)=IT(J)*10
01000 NW=K
01100 GO TO 600
01200 2740 IF(X.LT.1000..OR.X-J*10000.NE.CNT(J)+1.)GO TO 740
01300 X=BT+PR
01400 NW=K
01500 BX=CNT(J)+1.
01600 IT(J)=-3
01700 GO TO 600
01800 740 CONTINUE
01900 IT(J)=0
02000 1740 IF(J.LE.NINS)GO TO 31
02100 7021 K=J-NINS
02200 IF(JC.GT.0)K=JC
02300 5740 IF(PP1.LT.OP1)GO TO 1752
02400 IF(MZ)WRITE(JOUT,752),(OTH(K,L),L=2,16)
02500 IF(MX)WRITE(1,752)(OTH(K,L),L=2,16)
02600 C IF TF .NE.1, ALL INSERT TIMES MUST BE RESET
02700 C IF FIRST PART OF NOTE LIST IS 'OMITTED', CHECK YOUR 'INSERTS'.
02800 DO 17521 L=3,30
02900 17521 COPY(L)=-9900.
03000 C SO THAT ALL PARAMS WILL PRINT,AFTER AN INSERT.
03100 1752 BG(K+NINS)=19999.
03200 OTH(K,1)=19999.
03300 IF(JC.GT.0)GO TO 21
03400 31 KL=1
03500 IF(KB.EQ.0)GO TO 2031
03600 DO 1031 L=1,KB
03700 K=L
03800 X=OTH(K,1)-1000000.
03900 TO 203
06000 KN=IPT(J,1)-1
06100 IJ=V(KN)
06200 IF(IJ.EQ.4)GO TO 1203
06300 Z=(BT+9900.+V(KN-2))/V(KN+2)
06400 C******* FEB 19,71
06500 IF(Z.GT.1.)Z=1.
06600 Y=V(KN+3)
06700 X=(V(KN+4)-Y)*Z+Y
06800 C******* FEB 19,71
06900 IF(X.EQ.0)IPT(J,1)=0
07000 GO TO 204
07100 1203 X=V(KN+3)
07200 204 Y=RAND(0.0,1.0)
07300 IF(Y-X)MK=-1
07400
07500 203 DF=1.
07600 C DF=DUTY FACTOR
07700 DO 2155 L=2,NPA
07800 IJ=IPT(J,L)
07900 12031 IF(IJ)IJ=JPT(-IJ)
08000 IF(IJ)GO TO 12031
08100 C FOLLOWS UP ON POINTERS TO POINTERS!
08200 PM=1.
TO 203
06000 KN=IPT(J,1)-1
06100 IJ=V(KN)
06200 IF(IJ.EQ.4)GO TO 1203
06300 Z=(BT+9900.+V(KN-2))/V(KN+2)
06400 C******* FEB 19,71
06500 IF(Z.GT.1.)Z=1.
06600 Y=V(KN+3)
06700 X=(V(KN+4)-Y)*Z+Y
06800 C******* FEB 19,71
06900 IF(X.EQ.0)IPT(J,1)=0
07000 GO TO 204
07100 1203 X=V(KN+3)
07200 204 Y=RAND(0.0,1.0)
07300 IF(Y-X)MK=-1
07400
07500 203 DF=1.
07600 C DF=DUTY FACTOR
07700 DO 2155 L=2,NPA
07800 IJ=IPT(J,L)
07900 12031 IF(IJ)IJ=JPT(-IJ)
08000 IF(IJ)GO TO 12031
08100 C FOLLOWS UP ON POINTERS TO POINTERS!
08200 PM=1.
08300 IF(IJ.GT.1)GO TO 2157
08400 P(L)=0
08500 GO TO 2155
08600 2157 LN=IJ+2
08700 NM=V(IJ-1)+LN-4
08800 NL=V(IJ)
08900 KN=NL/(-11)
09000 IF(KN.EQ.0)GO TO 1100
09100 GO TO (61,62,62,62,65,65,67,68),KN
09200 1100 IF(V(IJ+1).EQ.1.)GO TO 1200
09300 ML=3
09400 1900 KA=1
09500 VX1=0
09600 DO 1156 K=LN,NM,ML
09700 VX(KA+1)=V(K)+VX(KA)
09800 1156 KA=KA+1
09900 X=RAND(0.0,1.)
10000 DO 1157 K=2,11
10100 IF(X.GT.VX(K))GO TO 1157
10200 KL=K-1
10300 IF(KN.EQ.7)GO TO 6157
10400 GO TO 1400
10500 1157 CONTINUE
10600 1400 LN=IJ+3*KL
10700 RA=V(LN)
10800 RB=V(LN+1)
10900 PAR=RAND(RA,RB)
11000 1300 IF(NL.NE.-1)PM=2.
11100 GO TO 1155
11200 1200 PAR=V(IJ+2)
11300 GO TO 1300
11400 61 X=P2
11500 IF(NL.EQ.-11)PL(L)=2.
11600 C '.5' MAKES ALL SUBR PARAMS PRINTOUT.
11700 CALL SUBR
11800 C******MAY 25,71
11900 IF(P(L).EQ.10000.)GO TO 5174
12000 C P(IPAR)=10000. IN 'SUBR' WILL CAUSE 'END' FOR INST.
12100 PM=PL(L)
12200 IF(L.EQ.2)GO TO 4203
12300 IF(X.EQ.P2)GO TO 2155
12400 PP2=P2
12500 PR=P2
12600 GO TO 2155
12700 C ABOVE IS FOR P2 CHANGES IN SUBROUTINE
12800 C TF,TEMPO,CONDUCT WILL AFFECT P2 ONLY WHEN P2 CALLS THE SUBR.,
12900 C ALL 'TEMPO' CHANGES WILL BE IGNORED!! (THEN DUR. IN SECS. MUST
13000 C BE SET TO 'REAL TIME'.)
13100
13200 C FOLLOWING IS FOR STRINGS OF VALUES.
13300 62 KL=NCNT(J,L)+1
13400 IF(KL.GT.V(IJ+1))KL=1
13500 PAR=V(IJ+KL+1)
13600 C********** MAY 13,71 RHY REPEAT FEATURE OMITTED.
13700 C************************
13800 4157 NCNT(J,L)=KL
13900 IF(NL.EQ.-45)DF=PAR
14000 IF(KN.NE.3)GO TO 1155
14100 C*******JULY 16,71 IF(PAR.EQ.101.)GO TO 5174
14200 IF(PAR.EQ.10000.)GO TO 5174
14300 PM=2.
14400 IF(PAR.GT.100..OR.PAR.LT.1.)PM=3.
14500 IF(PAR.EQ.85.)MK=-1
14600 GO TO 5155
14700 65 W=-9900.-V(IJ-3)
14800 C W=BG TIME OF MOVE.
14900 X=V(IJ-1)
15000 IF(NL.EQ.-56.OR.NL.EQ.-58)PM=2.
15100 Z=(BT-W)/V(IJ+1)
15200 C Z= % OF WAY THROUGH.
15300 IF(Z.GT.1.)Z=1.
15400 Y=V(LN)
15500 W=V(IJ+3)
15600 IF(X.EQ.7.)W=V(IJ+4)
15700 IF(NL.LT.-58)GO TO 16002
15800 PAR=(W-Y)*Z+Y
15900 IF(X.EQ.7.)GO TO 1600
16000 GO TO 1155
16100 C************** JUNE 1,71
16200 16002 PAR=(W-Y+1.)**Z-1.+Y
16300 IF(W-Y)PAR=(Y-W+1.)**(1.-Z)-1.+W
16400 IF(X.NE.7.)GO TO 1155
16500 W=V(IJ+5)
16600 Y=V(IJ+3)
16700 X=(W-Y+1.)**Z-1.+Y
16800 IF(W-Y)X=(Y-W+1.)**(1.-Z)-1.+W
16900 GO TO 16003
17000 C NEXT IS FOR MOVING RAND RANGES.
17100 C1600 PAR=(V(IJ+4)-Y)*Z+Y
17200 1600 W=V(IJ+3)
17300 C*********** BACK TO 65 IS NEW. FEB. 15,71
17400 X=(V(IJ+5)-W)*Z+W
17500 C************ JUNE 1,71
17600 16003 PAR=RAND(PAR,X)
17700 GO TO 1155
17800 67 LN=IJ+3
17900 NM=LN+V(IJ+1)-1
18000 ML=1
18100 GO TO 1900
18200 4155 K=(PAR-9999.0)*100.+.1
18300 P(L)=P(K)
18400 PM=PL(K)
18500 GO TO 21551
18600 C ANY # OVER 9999. REPEATS ANOTHER PARAM.(9999.21 REPEATS P21)
18700 6157 LN=V(LN-1)
18800 DO 1068 K=1,KL
18900 1068 IF(K.LT.KL)LN=LN+V(LN)+1
19000 2068 PM=LN+1
19100 PAR=LN+V(LN)
19200 GO TO 5155
19300 68 KL=NCNT(J,L)
19400 IF(KL.EQ.0.OR.KL.EQ.10000)KL=V(IJ+1)
19500 PM=KL+1
19600 PAR=PM+V(KL)-1
19700 KL=PAR+1
19800 IF(V(KL).EQ.10000.)DUR(J)=BT
19900 C 'END' OR 'FINE' IN 'LIT' LIST.
20000 IF(V(KL).EQ.999.)KL=IJ+2
20100 NCNT(J,L)=KL
20200 GO TO 5155
20300 C ******* JAN 20 *************
20400 1155 IF(PAR.EQ.10000.)GO TO 5174
20500 C TYPE 'END' AS LAST IN ANY STRING TO SET DURATION.
20600 IF((PAR.GT.9999.).AND.(PM.EQ.1.))GO TO 4155
20700 C****JULY 16,71 1155 IF((PAR.GT.9999.).AND.(PM.EQ.1.))GO TO 4155
20800 5155 P(L)=PAR
20900 21551 IF(L.EQ.2)GO TO 4203
21000 2155 PL(L)=PM
21100
21200 9203 IF(KB.EQ.0)GO TO 1170
21300 NL=KB
21400 DO 2203 K=1,KB
21500 X=OTH(NL,1)
21600 IF(X.LT.100000.)GO TO 2203
21700 L=X/100000.
21800 Y=(X-L*100000.)/100.
21900 IX=Y
22000 JC=NL
22100 IF(J.EQ.L.AND.IX.EQ.ICT)GO TO 5203
22200 2203 NL=NL-1
22300 GO TO 1170
22400 4203 PR=P2
22500 IF(T5.EQ.0)GO TO 7203
22600 IF(IT3.LE.1.OR.BT.LT.TBG+TDUR)GO TO 6203
22700 3155 IT3=IT3+3
22800 TBG=TBG+TDUR
22900 TDUR=V(IT3)
23000 IF(BT.GE.TBG+TDUR)GO TO 3155
23100 T1=V(IT3+1)
23200 T2=V(IT3+2)
23300 X=2.*TDUR/(T1+T2)
23400 AC=2.*(TDUR-T1*X)/X**2
23500 6203 RA=PR
23600 IF(BT.EQ.TBG)XT(J)=T1
23700 K=IT3
23800 RC=0
23900 RD=1
24000 KA=1
24100 RB=0
24200 Z=TDUR+TBG-BT
24300 X=T1
24400 Y=T2
24500 YY=AC
24600 CHN=TBG
24700 ZZ=TDUR
24800 GO TO 4020
24900 8203 P2=RA*RD
25000 7203 P2=P2*T4
25100 X=P2*TF
25200 C P2 IS KEPT WITHOUT TF*
25300 K=X+.5
25400 IF(X)K=X-.5
25500 72031 ROFF(J)=ROFF(J)+K-X
25600 IF(ABS(ROFF(J)).LT.1.)GO TO 7155
25700 Y=1.
25800 IF(ROFF(J))Y=-1.
25900 K=K-Y
26000 ROFF(J)=ROFF(J)-Y
26100 C ROUND-OFF GAP WILL NOT EXCEED .001
26200 C*********** FEB 17,71
26300 7155 PP2=K/1000.
26400 C AVOIDS ROUND-OFF PROBLEMS
26500 IF(IPT(J,31).EQ.0)GO TO 6155
26600 IF(ICT)GO TO 1170
26700 X=V(IPT(J,31)+2)
26800 Y=RAND(-X,X)
26900 PP2=PP2-RDEV(J)+Y
27000 RDEV(J)=Y
27300 K=PP2*1000.+.5
27400 61551 PP2=K/1000.
27500 C NEVER MORE THAN .1( DEVIATION WITH RAN TF. (RTF=.05)
27600 6155 IF(ICT)GO TO 9203
27700 GO TO 2155
27800 5203 JD=Y*100-IX*100+.5
27900 IF(JD.GT.0)GO TO 3203
28000 M=0
28100 P1(J)=PP1+PP2
28200 GO TO 7021
28300 3203 P(JD)=OTH(JC,2)
28400 X=OTH(JC,3)
28500 IF(X.NE.1.)X=3.
28600 C 'EDITS' PRINT,NUM. OR 5 CHARS.
28700 PL(JD)=X
28800 C 'TF' AND 'TEMPO' WILL NOT EFFECT PP2 'EDITS'.
28900 1170 IF(MK.OR.PP2)GO TO 2022
29000
29100 ZPAR=PP1
29200 P1(J)=PP1+PP2
29300 C ZPAR IS USED HERE WHEN OP1(OMIT) IS .GT.0. OMIT IS IN REAL TIME.
29400 LK=INST(J)
29500 2021 IF(PP1.LT.OP1)GO TO 2612
29600 IF(LK.EQ.'SEG'.OR.LK.EQ.'SYNTH')GO TO 2170
29700 C ALL PARAMS WILL PRINT,1ST TIME WHEN USING 'OMIT'.
29800 IF(INONLY.GT.0)GO TO 1204
29900 C*********** MAY 16,71 ↑↑↑
30000 6021 IF(P(NPA).NE.COPY(NPA).OR.PL(NPA).GT.1)GO TO 5021
30100 C******* MAY 25,71
30200 C 'LIT' DATA WILL ALWAYS PRINT.
30300 NPA=NPA-1
30400 IF(NPA.GT.2)GO TO 6021
30500 5021 DO 1304 K=3,NPA
30600 1304 COPY(K)=P(K)
30700 1204 IF(PL4.NE.1.)GO TO 2170
30800 P4=P4*AMPFAC
30900 L=0
31000 INP(J)=P4
31100 DO 1021 K=1,NINS
31200 1021 IF(P1(K).GT.PP1)L=L+INP(K)
31300 IF(L-IAMP-1)GO TO 2170
31400 IAMP=L
31500 AMPTIM=PP1
31600 2170 IF(MX.EQ.3)GO TO 2612
31700 C ********* MAY 17,71
31800 PP1=PP1-OP1
31900 C PUTS SPACES BETWEEN NOTES .GT. .05( APART
32000 IF((MZ.NE.-1).OR.(A.GE.PP1))GO TO 5170
32100 IF(INONLY)WRITE(JOUT,902)
32200 A=PP1+.05
32300 5170 IF((LK.NE.'SEG').AND.(LK.NE.'SYNTH'))GO TO 3170
32400 MLX=3
32500 C NEEDED TO INIT SYNTH AND SEG PRINT-OUT
32600 C NEXT CREATES FORMAT DATA IN IFM ARRAY.
32700 31701 KL=3
32800 GO TO 4170
32900 3170 IF(.NOT.INONLY.AND.J.NE.INONLY)GO TO 2612
33000 VX(1)=PP1
33100 VX2=PP2*DF
33200 IFM3='F9.3,'
33300 IFM4=IFM3
33400 KL=5
33500 ML=10
33600 IF(NPA.LT.10)ML=NPA
33700 MLX=3
33800 NL=2
33900 IF(NPA.LT.3)GO TO 2121
34000
34100 4170 NL=2
34200 DO 1121 K=MLX,ML
34300 X=P(K)
34400 L=PL(K)
34500 IF(L-2)321,521,621
34600 321 IF(X.GE.0)GO TO 4211
34700 IFM(KL)=IFCOM
34800 NL=NL+1
34900 KL=KL+1
35000 4211 IFM(KL)='F9.3,'
35100 C CREATES 'F9.3'
35200 421 VX(KL-NL)=X
35300 GO TO 1121
35400 521 IFM(KL)=IFM2
35500 C CREATES '1XA5'
35600 LN=X
35700 VX(KL-NL)=SCAL(LN)
35800 GO TO 42
35900 621 IF(L.GT.3)GO TO 721
36000 VX(KL-NL)=X
36100 C ABOVE LETS A5 WD BE USED IN SUBR BY SETTINNPA.LT.10)ML=NPA
33700 MLX=3
33800 NL=2
33900 IF(NPA.LT.3)GO TO 2121
34000
34100 4170 NL=2
34200 DO 1121 K=MLX,ML
34300 X=P(K)
34400 L=PL(K)
34500 IF(L-2)321,521,621
34600 321 IF(X.GE.0)GO TO 4211
34700 IFM(KL)=IFCOM
34800 NL=NL+1
34900 KL=KL+1
35000 4211 IFM(KL)='F9.3,'
35100 C CREATES 'F9.3'
35200 421 VX(KL-NL)=X
35300 GO TO 1121
35400 521 IFM(KL)=IFM2
35500 C CREATES '1XA5'
35600 LN=X
35700 VX(KL-NL)=SCAL(LN)
35800 GO TO 42
35900 621 IF(L.GT.3)GO TO 721
36000 VX(KL-NL)=X
36100 C ABOVE LETS A5 WD BE USED IN SUBR BY SETTING PL(N)=3.
36200 42 IFM(KL)=IFM2
36300 GO TO 1121
36400 721 LN=X
36500 IFM(KL)=I1X
36600 NL=NL+1
36700 DO 821 M=1,LN-L+1
36800 KL=KL+1
36900 IOUT(KL-NL)=IV(L-1+M)
37000 821 IFM(KL)=IA1
37100 1121 KL=KL+1
37200
37300 C NO MORE THAN 80 ITEMS IN FORMAT.
37400 2121 IF(KL.LE.80)GO TO 21211
37500 21212 FORMAT(' ERROR! TOO MANY LIT. ITEMS')
37600 TYPE 21212
37700 21211 DO 921 M=KL+1,80
37800 921 IFM(M)=IBLA
37900 IFM(KL)=')'
38000 L=KL-NL-1
38100 IF(MX)WRITE(1,IFM)LK,(VX(K),K=1,L)
38200 IF(.NOT.MZ)GO TO 30210
38300 IF(ML.GE.NPA)IFM(KL)='$)'
38400 WRITE(JOUT,IFM),LK,(VX(K),K=1,L)
38500 30210 IF(ML.GE.NPA)GO TO 3021
38600 MLX=ML+1
38700 ML=ML+10
38800 IF(ML.GT.NPA)ML=NPA
38900 LK=IBLA
39000 GO TO 31701
39100 3021 IF(MX)WRITE(1,3616)INST(J),ICT
39200 30211 IF(MZ)WRITE(JOUT,8902),INST(J),ICT,BT
39300 2612 PP1=ZPAR
39400 GO TO 21
39500 8902 FORMAT('+;< ',A5,I4,' >',F7.3)
39600 3616 FORMAT(';PRINT(P1);< ',A5,I4)
39700 C PRINTS RESTS
39800 2022 PP2=ABS(PP2)
39900 C IN THIS VERSION TYPE 'R' FOR RESTS IN ANY PARAM BUT P2.
40000 C FOR RESTS IN SEQS. TYPE -DUR.
40100 C WHEN RANDOM RESTS ARE CHOSEN, SEQS. MISS NOTES. RAN RESTS ARE NOT TOUCHED BY SUBROUTINES!!!
40200 INP(J)=0
40300 P1(J)=PP1+PP2
40400 IF((MZ.NE.-1).OR.(PP1.LT.OP1))GO TO 21
40500 X=PP1-OP1
40600 IF(A.GE.X)GO TO 121
40700 WRITE(JOUT,902)
40800 A=X+.05
40900 121 IF(INONLY.OR.J.EQ.INONLY)WRITE(JOUT,1110),INST(J),X,P2,ICT
41000 21 PR=ABS(PR)
41100 BG(J)=BT+PR
41200 IF(ICT.EQ.DUR(J)-10000.)GO TO 5174
41300 IF(BG(J).LT.DUR(J))GO TO 500
41400 5174 BG(J)=19999.
41500 DO 3174 K=1,NINS
41600 C INSERTS CANT FOLLOW LAST REGULAR NOTE.(ADD REST IF INSERT AT END IS NEEDED.)
41700 3174 IF(BG(K).LT.19999.)GO TO 500
41800 GO TO 175
41900 C CHOOSES INST WITH NEXT BEGIN TIME.
42000 500 J=1
42100 BW=BT
42200 NL=NINS+KB
42300 DO 22 K=2,NL
42400 22 IF(BG(J).GT.BG(K))J=K
42500 IF(J.GT.NINS.OR.NINS.EQ.1)GO TO 3022
42600 J=1
42700 DO 5022 K=2,NINS
42800 X=P1(J)
42900 Y=P1(K)+.0001
43000 C LOWEST NUMBERED INST WILL COME 1ST IF BG TIMES ARE VERY CLOSE
43100 IF(BG(J).EQ.19999.)X=19999.
43200 IF(BG(K).EQ.19999.)Y=19999.
43300 5022 IF(X.GT.Y)J=K
43400 C ABOVE IS FOR ROUND-OFF PROBLEMS WITH 'TEMPO' AND 'CONDUCT'.
43500 3022 BT=BG(J)
43600 IF((BT.EQ.19999.).OR.(P1(J).GE.DURX))GO TO 175
43700 IF(CNT(J).GT.0)GO TO 1022
43800 IF(CNT(J).EQ.0)P1(J)=0
43900 IF(CNT(J).EQ.-1)CNT(J)=0
44000 C N.B. 'TF' CONTROLS BG TIME WHEN BG .GT. 0
44100 1022 IF((BT.LT.T6).OR.(IT3.GT.1))GO TO 1108
44200 T4=T2
44300 T5=0
44400 T6=10000.
44500 GO TO 1108
44600 1175 FORMAT('+',A5,'=',F7.3,2X,$)
44700 1109 FORMAT(' FINISH; < ',A5,'.DAT')
44800 1110 FORMAT(' <',A5,2F9.3,7X,'REST <',I3)
44900 1603 FORMAT(' AMPL. FACTOR=',F4.2,', MAX.AMP.=',I4,', AT TIME',
45000 1 F8.3)
45100 175 IF(MZ)WRITE(JOUT,1109),ISLAC
45200 IF(MX.GE.0)GO TO 603
45300 WRITE(1,1109),ISLAC
45400 END FILE 1
45500 603 FORMAT(' TOTAL DURS: ',$)
45600 IF(MZ)GO TO 4175
45700 TYPE 1603,AMPFAC,IAMP,AMPTIM
45800 TYPE 603
45900 GO TO 5175
46000 4175 WRITE(JOUT,1603),AMPFAC,IAMP,AMPTIM
46100 WRITE(JOUT,603)
46200 5175 DO 2175 K=1,NINS
46300 X=P1(K)-OP1
46400 IF(MZ)GO TO 6175
46500 TYPE 1175,INST(K),X
46600 GO TO 2175
46700 6175 WRITE(JOUT,1175),INST(K),X
46800 2175 CONTINUE
46900 IF(JOUT.NE.22)GO TO 3175
47000 END FILE 22
47100 CALL PRINT
47200 REWIND 22
47300 K='FOR22'
47400 CALL OFILE(22,K)
47500 END FILE 22
47600 3175 TYPE 1023,ISLAC
47700 END